home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 46 / Amiga Format CD46 (1999-10-20)(Future Publishing)(GB)[!][issue 1999-12].iso / -in_the_mag- / reader_requests / scilab / demos / velpic / id_rgn.f < prev    next >
Text File  |  1999-09-16  |  2KB  |  66 lines
  1.       subroutine id_rgn(indexlist,linelist,seed,ind,nol,nolt,
  2.      +                  ic,icount,noe,newlist,bav,lln,ncount)
  3.       
  4. c Macro which determines all the indices of a matrix of dimension
  5. c (nz X nx) which are in the foobar defined by the seed and the 
  6. c linelist.  The elements which are in the same foobar as the seed
  7. c are those which are on the same side of all the lines in the
  8. c linelist.
  9. c  indexlist :(2xN) vector containing all the indices to be searched
  10. c  linelist  :list of lines
  11. c  seed      :pair of indices of the matrix identifying the foobar
  12. c  ind       :all indices of the matrix associated to the foobar
  13. c            :defined by seed
  14. c 
  15. c  author: C. Bunks     date: 12-NOV-90
  16.  
  17.       integer   ind,indexlist,newlist,noe,ix
  18.       integer   nol,nolt,flag,ncount,icount
  19.       real      seed,linelist,lln,bav,p1
  20.       dimension linelist(2,nolt),noe(ic),bav(3,nolt),seed(1,2)
  21.       dimension indexlist(2,ic),newlist(2,ic),p1(1,2)
  22.       dimension ind(2,ic),lln(2,nolt)
  23.  
  24. c if the line segment defined by the seed and another pair of indices
  25. c intersects any line in the linelist then that pair of indices is
  26. c not in the foobar
  27.  
  28.       ncount=0
  29.       icount=0
  30.       do 10 ii=1,ic 
  31. c     !cycle through all indices
  32.          p1(1,1)=float(indexlist(1,ii))
  33.          p1(1,2)=float(indexlist(2,ii))
  34.          ln=1
  35.          flag=0               
  36. c     !while flag=0 cycle thru lines
  37.          do while(flag.eq.0)  
  38. c     !cycle thru edges till xsection occurs
  39.             if(ln.le.nol)then
  40.                noe1=noe(ln)
  41.                noe2=noe(ln+1)-1
  42.                do 20 ll=noe1,noe2
  43.                   lln(1,ll-noe1+1)=linelist(1,ll)
  44.                   lln(2,ll-noe1+1)=linelist(2,ll)
  45.  20            continue
  46.                call testpt(p1,float(seed),noe2-noe1+1,lln,flag,ix,bav)
  47.                if(flag.eq.1)then 
  48. c     !intersection occurred
  49.                   ncount=ncount+1
  50.                   newlist(1,ncount)=int(p1(1,1))
  51.                   newlist(2,ncount)=int(p1(1,2))
  52.                endif
  53.             else        
  54. c     !no intersection occurred for index pair
  55.                icount=icount+1
  56.                ind(1,icount)=int(p1(1,1))
  57.                ind(2,icount)=int(p1(1,2)) 
  58.                flag=1
  59.             endif
  60.             ln=ln+1
  61.          end do
  62.  10   continue
  63.  
  64.       return
  65.       end
  66.